home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / BACKUP / FSP111.ZIP;1 / FSP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-24  |  7.1 KB  |  212 lines
  1. PROGRAM FSP;
  2. {------------------------------------------------------------------------------
  3.  
  4.                                 REVISION HISTORY
  5.  
  6. v1.00  : 1993/07/14.  First public release.  DDA
  7. v1.01  : 1993/12/26.  Now discards data from FIRST CD-ROM drive.  DDA
  8. v1.02  : 1994/01/20.  Now only reports valid local (inc. RAM) drives,
  9.                       C through Z.  Remote, SUBST, and CD drives ignored.  DDA
  10. v1.10  : 1994/01/23.  Added volume label info.  Edward Dombek (73727,162)
  11. v1.11  : 1994/01/24.  Integrated various previous suggestions above.  DDA
  12.  
  13. ------------------------------------------------------------------------------}
  14.  
  15. USES Crt, Dos;                       {Crt for colors, Dos for DiskSize/Free.}
  16. CONST
  17.    ProgData = 'FSP (Free SPace), v1.11- DOS Multiple Hard Disk Space Utilization Utility.';
  18.    ProgDat2 = 'FREE software!  Copyright: 94/01/24 by David Daniel Anderson - Reign Ware.';
  19.    ProgDat3 = 'DRIVE       ALLOCATED    FREE SPACE    TOTAL SPACE   FREE %   LABEL';
  20. VAR
  21.  
  22.    TS,TF,TU : LongInt;  {integer of Total space Size/Free/Used}
  23.                         {maximum disk size of LongInt: 2 147 483 647 }
  24.  
  25.  
  26. FUNCTION Comma(i : LongInt) : String; {Used in WriteDriveInfo & WriteTotalInfo}
  27. VAR w : String[14];                  {Insert commas to break up number string.}
  28.     c : ShortInt;
  29. BEGIN
  30.     Str(i,w);
  31.  
  32.     c := (Length(w) - 3);
  33.     WHILE c > 0 DO
  34.     BEGIN
  35.       Insert(',',w,c+1);
  36.       c := c - 3;
  37.     END;
  38.  
  39.     Comma := w;
  40. END;
  41.  
  42. FUNCTION LeadingZero(w : Word) : String;  {Called by WriteDTInf to write time.}
  43. VAR  s : String;
  44. BEGIN
  45.      Str(w:0,s);
  46.      IF Length(s) = 1 THEN
  47.        s := '0' + s;
  48.      LeadingZero := s;
  49. END;
  50.  
  51. PROCEDURE WriteDTInf;            {Called by WriteHeader to write Date & Time.}
  52. CONST
  53.   Mon : Array [1..12] of String[9] =
  54.         ('January','February','March','April','May','June','July',
  55.          'August','September','October','November','December');
  56. VAR
  57.      Year,Month,Day, dow,
  58.      Hour,Min,Sec, hund    : Word;
  59.      i                     : ShortInt;
  60.      DStr,
  61.      YStr,
  62.      DateStr               : String[66];
  63. BEGIN
  64.      GetDate(Year,Month,Day,dow);
  65.      GetTime(Hour,Min,Sec,hund);
  66.      Str(Day,DStr);
  67.      Str(Year,YStr);
  68.      DateStr := Mon[Month] + ' ' + DStr + ', ' + YStr;
  69.      WHILE ( (Length (DateStr)) < 66) DO
  70.            DateStr := DateStr + ' ' ;
  71.  
  72.      WriteLn(DateStr,
  73.              LeadingZero(Hour),':',
  74.              LeadingZero(Min),':',
  75.              LeadingZero(Sec));
  76. END;
  77.  
  78. PROCEDURE WriteHeader;                 {Called by main.}
  79. CONST
  80. hyphens = '--------------------------------------------------------------------------';
  81. VAR  i : ShortInt;
  82. BEGIN
  83.      TextBackGround(Blue);  TextColor(White);
  84.      WriteLn(ProgData);                                   {...a constant...}
  85.      WriteLn(ProgDat2);                                   {...a constant...}
  86.      TextBackGround(Black); TextColor(LightBlue);
  87.      WriteDTInf;
  88.      TextColor(LightCyan);
  89.      WriteLn(ProgDat3);                                   {...a constant...}
  90.      WriteLn(hyphens);
  91. END;
  92.  
  93. PROCEDURE WritePercent(TFree,TSpace : LongInt);   {Called by WriteDriveInfo  }
  94.                                                   {        & WriteTotalInfo. }
  95. VAR  SPF : String[8];          {String of Percentage Free}
  96.      PF  : Integer;       {integer of Percentage Free, initially 10 x %}
  97. BEGIN
  98.      PF := Round(1000 * (TFree / TSpace));    {Using 1000 to give tenths of %}
  99.      Str(PF,SPF);
  100.      Insert('.',SPF,(Length(SPF)));   {Insert period for tenths of a percent.}
  101.      TextColor(White);         Write(SPF:8,'%');
  102. END;
  103.  
  104. PROCEDURE WriteInColor(u,f,s : LongInt);
  105. BEGIN
  106.      TextColor(LightRed);      Write(Comma(U):14);
  107.      TextColor(LightGreen);    Write(Comma(F):14);
  108.      TextColor(Magenta);       Write(Comma(S):15);
  109. END;
  110.  
  111. PROCEDURE WriteDriveInfo(DriveCounter:byte);    {Called by main.}
  112. VAR  DS,DF,DU : LongInt;        {integer of Disk space Size/Free/Used}
  113.      Fblock   : SearchRec;
  114.      VolName  : String;
  115. BEGIN
  116.      DS := DiskSize(DriveCounter);
  117.      DF := DiskFree(DriveCounter);
  118.      DU := DS - DF;
  119.      TS := TS + DS;    TF := TF + DF;    TU := TU + DU;
  120.  
  121.      TextColor(Yellow);        Write(Chr(DriveCounter+64),' -->  ');
  122.      WriteInColor(DU,DF,DS);
  123.      WritePercent(DF,DS);                          {...a procedure...}
  124. {!}
  125.      FindFirst(Chr(DriveCounter+64)+':\*.*',$8,Fblock);  {...Volume Label?...}
  126.  
  127.      If DosError <> 0 then
  128.         VolName := 'none'
  129.      else
  130.      begin
  131.         VolName := Fblock.Name;
  132.         if (pos('.',VolName) <> 0) then
  133.           delete (VolName,pos('.',VolName),1);  { remove period if present }
  134.     {     delete (VolName,9,1);    } {...Remove period from 9th position...}
  135.      end;
  136.      TextColor(Yellow);        WriteLn('   ',VolName);
  137. END;
  138.  
  139. PROCEDURE WriteTotalInfo;                          {Called by main.}
  140. CONST
  141. eqline = '==========================================================================';
  142. VAR  i : ShortInt;
  143. BEGIN
  144.      TextColor(LightGray);
  145.      WriteLn (eqline);
  146.  
  147.      TextColor(Yellow);        Write('TOTALS=');
  148.      WriteInColor(TU,TF,TS);
  149.      WritePercent(TF,TS);                          {...a procedure...}
  150.      WriteLn;
  151. END;
  152.  
  153. {=============================================================================}
  154.  
  155. Function IsDriveValid(cDrive: Char; Var bLocal, bSUBST: Boolean): Boolean;
  156. { ** SWAG snippet
  157.  
  158.   Parameters: cDrive is the drive letter, 'A' to 'Z', that's about
  159.   to be checked. if not in this range, the Function will return False.
  160.  
  161.   Returns: Function returns True if the given drive is valid, else
  162.   False (!). bLocal is set if drive is local, bSUBST if drive is
  163.   substituted. if Function returns False, the Booleans are undefined.
  164. }
  165. Var
  166.   rCPU: Dos.Registers;
  167. begin
  168.   { --- Call Dos and process returns --- }
  169.   if not (UpCase(cDrive) in ['A'..'Z']) then { --- letter OK?--- }
  170.     IsDriveValid := False
  171.   else
  172.   begin
  173.     { --- Valid letter, set up For the Dos-call --- }
  174.     rCPU.bx := ord(UpCase(cDrive))-ord('A')+1;
  175.     rCPU.ax := $4409;
  176.     { --- Call the Dos IOCTL (InOutConTroL)-Functions --- }
  177.     Intr($21, rCPU);
  178.     if (rCPU.ax and FCarry) = FCarry then
  179.       IsDriveValid := False
  180.     else
  181.     begin { --- drive is valid, check status --- }
  182.       IsDriveValid := True;
  183.       bLocal := ((rCPU.dx and $1000) = $0000);
  184.       if bLocal then
  185.         bSUBST := ((rCPU.dx and $8000) = $8000)
  186.       else
  187.         bSUBST := False;
  188.     end;
  189.   end;
  190. end; { IsDriveValid }
  191. {=============================================================================}
  192.  
  193. Var
  194.   cCurChar : Char ;          { loop counter, drive }
  195.   bLocal,
  196.   bSUBST   : Boolean ;       { drive local/remote?; SUBSTed or not? }
  197.  
  198. BEGIN
  199.   TS := 0;  TF := 0;  TU := 0;
  200.   IF ParamStr(1) = '' THEN ClrScr;{Clear screen unless ANY parameter given.}
  201.  
  202.   WriteHeader;                           {...a procedure...}
  203.  
  204.   For cCurChar := 'C' to 'Z' do
  205.     if IsDriveValid(cCurChar, bLocal, bSUBST) then
  206.       if (blocal and (not bSUBST)) then
  207.           WriteDriveInfo(ord(cCurChar)-64);
  208.  
  209.   WriteTotalInfo;                        {...a procedure...}
  210.   NormVideo;
  211. END.
  212.